home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / complxo.exe / CDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-15  |  12.8 KB  |  412 lines
  1. {$N+,E+}
  2. PROGRAM cdemo;
  3.  
  4.  {This PROGRAM demonstrates the use of the ComplexOps UNIT.
  5.  
  6.   (C) Copyright 1990, 1992, Earl F. Glynn, Overland Park, KS.  Compuserve 73257,3527.
  7.   All rights reserved.  This program may be freely distributed only for
  8.   non-commercial use.}
  9.  
  10.  
  11.   USES ComplexOps;
  12.  
  13.   VAR
  14.     a      :  ARRAY[1..22] OF Complex;
  15.     csave  :  ARRAY[1..22] OF Complex;
  16.     k,m    :  WORD;
  17.     n      :  INTEGER;
  18.     x,y    :  RealType;
  19.     z,z1,z2:  Complex;
  20.  
  21. BEGIN
  22.  
  23.   WRITELN ('Demo ComplexOPs PROCEDUREs and FUNCTIONs');
  24.   WRITELN;
  25.   WRITELN ('  Notes:  1.  CIS(w) = COS(w) + i*SIN(w), w = -PI..PI');
  26.   WRITELN ('          2.  z = x + i*y');
  27.   WRITELN;
  28.   WRITELN;
  29.  
  30.   CSet (a[ 1],  0.0,  0.0, rectangular);
  31.   CSet (a[ 2],  0.5,  0.5, rectangular);
  32.   CSet (a[ 3], -0.5,  0.5, rectangular);
  33.   CSet (a[ 4], -0.5, -0.5, rectangular);
  34.   CSet (a[ 5],  0.5, -0.5, rectangular);
  35.   CSet (a[ 6],  1.0,  0.0, rectangular);
  36.   CSet (a[ 7],  1.0,  1.0, rectangular);
  37.   CSet (a[ 8],  0.0,  1.0, rectangular);
  38.   CSet (a[ 9], -1.0,  1.0, rectangular);
  39.   CSet (a[10], -1.0,  0.0, rectangular);
  40.   CSet (a[11], -1.0, -1.0, rectangular);
  41.   CSet (a[12],  0.0, -1.0, rectangular);
  42.   CSet (a[13],  1.0, -1.0, rectangular);
  43.   CSet (a[14],   5.,   0., rectangular);
  44.   CSet (a[15],   5.,   3., rectangular);
  45.   CSet (a[16],   0.,   3., rectangular);
  46.   CSet (a[17],  -5.,   3., rectangular);
  47.   CSet (a[18],  -5.,   0., rectangular);
  48.   CSet (a[19],  -5.,  -3., rectangular);
  49.   CSet (a[20],   0.,  -3., rectangular);
  50.   CSet (a[21],  -5.,  -3., rectangular);
  51.   CSet (a[22], -20.,  20., rectangular);
  52.  
  53.   WRITELN ('Complex number definition/conversion/output:  CSet/CConvert/CStr');
  54.   WRITELN;
  55.   WRITELN ('   z rectangular':25,'z polar':28);
  56.   WRITELN ('     ---------------------------   ',
  57.     '-----------------------------');
  58.   FOR k := 1 TO 21 DO
  59.     WRITELN (k:3,'  ',CStr(a[k],12,8,rectangular),'  ',
  60.                      CStr(a[k],12,8,polar));
  61.   WRITELN;
  62.   WRITELN;
  63.  
  64.   WRITELN ('Complex arithmetic:  CAdd, CSub, CMult, CDiv');
  65.   WRITELN;
  66.  
  67.   CSet (z1,  1, 1, rectangular);
  68.   WRITELN ('Let z1 = ':12,CStr(z1,8,3,rectangular):20,' or ',
  69.                       CStr(z1,8,3,polar));
  70.   CSet (z2, SQRT(3), -1, rectangular);
  71.   WRITELN ('z2 = ':12,CStr(z2,8,3,rectangular):20,' or ',
  72.                       CStr(z2,8,3,polar));
  73.   WRITELN;
  74.  
  75.   CAdd  (z,z1,z2);
  76.   WRITELN ('z1 + z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  77.                            CStr(z,8,3,polar));
  78.  
  79.   CSub  (z,z1,z2);
  80.   WRITELN ('z1 - z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  81.                            CStr(z,8,3,polar));
  82.  
  83.   CMult (z,z1,z2);
  84.   WRITELN ('z1 * z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  85.                            CStr(z,8,3,polar));
  86.  
  87.   CDiv  (z,z1,z2);
  88.   WRITELN ('z1 / z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
  89.                            CStr(z,8,3,polar));
  90.   WRITELN;
  91.   WRITELN;
  92.  
  93.   WRITELN ('Complex natural logarithm:  CLn = LN(z)');
  94.   WRITELN;
  95.   WRITELN ('  Notes:  1.  LN(z) is multivalued.');
  96.   WRITELN (' ':9,' 2.  Any multiple of 2*PI*i could be added to/',
  97.     'subtracted from LN(z).');
  98.   WRITELN (' ':9,' 3.  LN(1)=0; LN(-1)=PI*i; LN(+/-i)=+/-0.5*PI*i.');
  99.   WRITELN;
  100.   WRITELN ('LN(z)':35);
  101.   WRITELN ('z':11,'rectangular':27,'EXP( LN(z) ) = z':32);
  102.   WRITELN ('     ------------  ---------------------------  ',
  103.     '---------------------------');
  104.   FOR k := 1 TO 22 DO BEGIN
  105.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  106.     IF   CAbs(a[k]) = 0.0
  107.     THEN WRITELN ('undefined':18)
  108.     ELSE BEGIN
  109.       CLn (z,a[k]);
  110.       CExp (z1,z);
  111.       WRITELN (CStr(z,12,9,rectangular),'  ',CStr(z1,12,9,rectangular))
  112.     END
  113.   END;
  114.   WRITELN;
  115.   WRITELN;
  116.  
  117.   WRITELN ('Complex exponential:  CExp = EXP(z)');
  118.   WRITELN;
  119.   WRITELN ('EXP(z)':35);
  120.   WRITELN ('z':11,'rectangular':27,'LN( EXP(z) ) = z':32);
  121.   WRITELN ('     ------------  ---------------------------  ',
  122.     '---------------------------');
  123.   FOR k := 1 TO 22 DO BEGIN
  124.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  125.     CExp (z,a[k]);
  126.     CLn (z1,z);
  127.     IF   CAbs(z) > 10.0
  128.     THEN m := 7
  129.     ELSE m := 9;
  130.     WRITELN (CStr(z,12,m,rectangular),'  ',CStr(z1,12,m,rectangular))
  131.   END;
  132.   WRITELN;
  133.   WRITELN;
  134.  
  135.   WRITELN ('Complex power:  CPwr = z1^z2');
  136.   WRITELN;
  137.   WRITELN ('z^(-1+i)':36,'z^(-1+i)':29);
  138.   WRITELN ('z':11,'rectangular':27,'polar':26);
  139.   WRITELN ('     ------------  ---------------------------  ',
  140.     '-----------------------------');
  141.   CSet (z1, -1,1, rectangular);
  142.   FOR k := 1 TO 21 DO BEGIN
  143.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  144.     IF   CAbs(a[k]) = 0.0
  145.     THEN WRITELN ('undefined':18)
  146.     ELSE BEGIN
  147.       CPwr (z,a[k],z1);
  148.       WRITELN (CStr(z,12,9,rectangular),' ',CStr(z,12,9,polar))
  149.     END
  150.   END;
  151.   WRITELN;
  152.   WRITELN;
  153.  
  154.   WRITELN ('Complex cosine:  CCos = COS(z)');
  155.   WRITELN;
  156.   WRITELN ('COS(z)':35,'COS(z)':29);
  157.   WRITELN ('z':11,'rectangular':27,'polar':26);
  158.   WRITELN ('     ------------  ---------------------------  ',
  159.     '-----------------------------');
  160.   FOR k := 1 TO 21 DO BEGIN
  161.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  162.     CCos (z,a[k]);
  163.     CIntPwr (csave[k], z,2);  {save COS^2}
  164.     IF   CAbs(z) > 10.0
  165.     THEN m := 7
  166.     ELSE m := 9;
  167.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  168.   END;
  169.   WRITELN;
  170.   WRITELN;
  171.  
  172.   WRITELN ('Complex sine:  CSin = SIN(z)');
  173.   WRITELN;
  174.   WRITELN ('SIN(z)':35);
  175.   WRITELN ('z':11,'rectangular':27,'SIN^2(z)+COS^2(z)=1':32);
  176.   WRITELN ('     ------------  ---------------------------  ',
  177.     '---------------------------');
  178.   FOR k := 1 TO 21 DO BEGIN
  179.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  180.     CSin (z,a[k]);
  181.     CIntPwr (z1, z,2);      {SIN^2}
  182.     CAdd (z1, z1,csave[k]); {SIN^2 + COS^2}
  183.     IF   CAbs(z) > 10.0
  184.     THEN m := 7
  185.     ELSE m := 9;
  186.     WRITELN (CStr(z,12,m,rectangular),'  ',CStr(z1,12,9,rectangular))
  187.   END;
  188.   WRITELN;
  189.   WRITELN;
  190.  
  191.   WRITELN ('Complex tangent:  CTan = TAN(z)');
  192.   WRITELN;
  193.   WRITELN ('TAN(z)':35,'TAN(z)':29);
  194.   WRITELN ('z':11,'rectangular':27,'polar':26);
  195.   WRITELN ('     ------------  ---------------------------  ',
  196.     '-----------------------------');
  197.   FOR k := 1 TO 21 DO BEGIN
  198.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  199.     CTan (z,a[k]);
  200.     IF   CAbs(z) > 10.0
  201.     THEN m := 7
  202.     ELSE m := 9;
  203.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  204.   END;
  205.   WRITELN;
  206.   WRITELN;
  207.  
  208.   WRITELN ('Complex hyperbolic cosine:  CCosh = COSH(z)');
  209.   WRITELN;
  210.   WRITELN ('COSH(z)':36,'COSH(z)':29);
  211.   WRITELN ('z':11,'rectangular':27,'polar':26);
  212.   WRITELN ('     ------------  ---------------------------  ',
  213.     '-----------------------------');
  214.   FOR k := 1 TO 21 DO BEGIN
  215.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  216.     CCosh (z,a[k]);
  217.     CIntPwr (csave[k], z,2);  {save COSH^2}
  218.     IF   CAbs(z) > 10.0
  219.     THEN m := 7
  220.     ELSE m := 9;
  221.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  222.   END;
  223.   WRITELN;
  224.   WRITELN;
  225.  
  226.   WRITELN ('Complex hyperbolic sine:  CSinh = SINH(z)');
  227.   WRITELN;
  228.   WRITELN ('SINH(z)':36);
  229.   WRITELN ('z':11,'rectangular':27,'COSH^2(z)-SINH^2(z)=1':34);
  230.   WRITELN ('     ------------  ---------------------------  ',
  231.     '---------------------------');
  232.   FOR k := 1 TO 21 DO BEGIN
  233.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  234.     CSinh (z,a[k]);
  235.     CIntPwr (z1, z,2);      {SINH^2}
  236.     CSub (z1, csave[k],z1); {COSH^2 - SINH^2}
  237.     IF   CAbs(z) > 10.0
  238.     THEN m := 7
  239.     ELSE m := 9;
  240.     WRITELN (CStr(z,12,m,rectangular),'  ',CStr(z1,12,9,rectangular))
  241.   END;
  242.   WRITELN;
  243.   WRITELN;
  244.  
  245.   WRITELN ('Complex hyperbolic tangent:  CTanh = TANH(z)');
  246.   WRITELN;
  247.   WRITELN ('TANH(z)':36,'TANH(z)':29);
  248.   WRITELN ('z':11,'rectangular':27,'polar':26);
  249.   WRITELN ('     ------------  ---------------------------  ',
  250.     '-----------------------------');
  251.   FOR k := 1 TO 21 DO BEGIN
  252.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  253.     CTanh (z,a[k]);
  254.     IF   CAbs(z) > 10.0
  255.     THEN m := 4
  256.     ELSE m := 9;
  257.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  258.   END;
  259.   WRITELN;
  260.   WRITELN;
  261.  
  262.   WRITELN ('Absolute value of complex number:  CAbs = ABS(z)');
  263.   WRITELN;
  264.   WRITELN ('z':11,'ABS(z)':17);
  265.   WRITELN ('     ------------  ------------');
  266.   FOR k := 1 TO 21 DO BEGIN
  267.     WRITELN (k:3,' ',CStr(a[k],5,1,rectangular),'  ',CAbs(a[k]):12:9)
  268.   END;
  269.   WRITELN;
  270.  
  271.   WRITELN ('Complex integer power:  CIntPwr = z^n  ',
  272.     '(using DeMoivre''s Theorem)');
  273.   WRITELN;
  274.   WRITELN ('z^3':34,'z^3':29);
  275.   WRITELN ('z':11,'rectangular':27,'polar':26);
  276.   WRITELN ('     ------------  ---------------------------  ',
  277.     '-----------------------------');
  278.   FOR k := 1 TO 21 DO BEGIN
  279.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  280.     IF   CAbs(a[k]) = 0.0
  281.     THEN WRITELN ('undefined':18)
  282.     ELSE BEGIN
  283.       CIntPwr (z,a[k],3);
  284.       IF   CAbs(z) > 10.0
  285.       THEN m := 7
  286.       ELSE m := 9;
  287.       WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  288.     END
  289.   END;
  290.   WRITELN;
  291.   WRITELN;
  292.  
  293.   WRITELN ('Complex conjugate:  CConjugate = z*');
  294.   WRITELN;
  295.   WRITELN ('z*':35,'z*':29);
  296.   WRITELN ('z':11,'rectangular':28,'polar':26);
  297.   WRITELN ('     ------------  ---------------------------  ',
  298.     '-----------------------------');
  299.   FOR k := 1 TO 21 DO BEGIN
  300.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  301.     CConjugate (z,a[k]);
  302.     WRITELN (CStr(z,12,8,rectangular),' ',CStr(z,12,8,polar))
  303.   END;
  304.   WRITELN;
  305.   WRITELN;
  306.  
  307.   WRITELN ('Complex square root:  CSqrt = SQRT(z)');
  308.   WRITELN;
  309.   WRITELN ('SQRT(z)':36,'SQRT(z)':28);
  310.   WRITELN ('z':11,'root 1':25,'root 2':28);
  311.   WRITELN ('     ------------  ---------------------------  ',
  312.     '---------------------------');
  313.   FOR k := 1 TO 21 DO BEGIN
  314.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  315.     CSqrt (z,a[k]);       {same as CRoot (z,a[k],0,2)}
  316.     CRoot (z1,a[k],1,2);
  317.     WRITELN (CStr(z,12,9,rectangular),'  ',CStr(z1,12,9,rectangular))
  318.   END;
  319.   WRITELN;
  320.   WRITELN;
  321.  
  322.   WRITELN ('The three cube roots of -1+i:  (-1+i)^(1/3)');
  323.   WRITELN ('(See Schaum''s Outline Series "Complex Variables", 1964, ',
  324.     'p. 18, problem 29.)');
  325.   WRITELN;
  326.   WRITELN ('z^(1/3)':35,'z^(1/3)':29);
  327.   WRITELN ('z':11,'rectangular':27,'polar':26);
  328.   WRITELN ('     ------------  ---------------------------  ',
  329.     '-----------------------------');
  330.   CSet (z1, -1,1, rectangular);
  331.   FOR k := 0 TO 2 DO BEGIN
  332.     WRITE (k:3,' ',CStr(z1,5,1,rectangular),'  ');
  333.     CRoot (z,z1,k,3);
  334.     WRITELN (CStr(z,12,9,rectangular),' ',CStr(z,12,9,polar))
  335.   END;
  336.   WRITELN;
  337.   WRITELN;
  338.  
  339.   WRITELN ('Complex Bessel function:  CI0 = I0(z)');
  340.   WRITELN;
  341.   WRITELN ('I0(z)':36,'I0(z)':29);
  342.   WRITELN ('z':11,'rectangular':27,'polar':26);
  343.   WRITELN ('     ------------  ---------------------------  ',
  344.     '-----------------------------');
  345.   FOR k := 1 TO 21 DO BEGIN
  346.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  347.     CI0 (z,a[k]);
  348.     IF   CAbs(z) > 10.0
  349.     THEN m := 7
  350.     ELSE m := 9;
  351.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  352.   END;
  353.   WRITELN;
  354.   WRITELN;
  355.  
  356.   WRITELN ('Complex Bessel function:  CJ0 = J0(z)');
  357.   WRITELN;
  358.   WRITELN ('J0(z)':36,'J0(z)':29);
  359.   WRITELN ('z':11,'rectangular':27,'polar':26);
  360.   WRITELN ('     ------------  ---------------------------  ',
  361.     '-----------------------------');
  362.   FOR k := 1 TO 21 DO BEGIN
  363.     WRITE (k:3,' ',CStr(a[k],5,1,rectangular),'  ');
  364.     CJ0 (z,a[k]);
  365.     IF   CAbs(z) > 10.0
  366.     THEN m := 7
  367.     ELSE m := 9;
  368.     WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
  369.   END;
  370.   WRITELN;
  371.   WRITELN;
  372.  
  373.   WRITELN ('Removing "Fuzz" from real numbers for zero test:');
  374.   WRITELN;  {Note:  CStr calls CConvert that calls CDefuzz}
  375.   CSet (z, -3.21E-14,7.65E-14, rectangular);
  376.   WRITELN ('  Before:  ',z.x:18:15,' +',z.y:18:15,'i');
  377.   CDeFuzz (z);
  378.   WRITELN ('   After:  ',CStr(z,18,15,rectangular));
  379.   WRITELN;
  380.   CSet (z, -3.21E-14,PI, polar);
  381.   WRITELN ('  Before:  ',z.r:18:15,'*CIS(',z.theta:18:15,')');
  382.   CDeFuzz (z);
  383.   WRITELN ('   After:  ',CStr(z,18,15,polar));
  384.   WRITELN;
  385.   WRITELN;
  386.  
  387.   WRITELN ('Miscellaneous:  FixAngle -- keep angle in interval (-PI..PI)');
  388.   WRITELN;
  389.  
  390.   WRITELN ('     radians FixAngle');
  391.   WRITELN ('    -------- --------');
  392.   FOR n := -4 TO 8 DO BEGIN
  393.     x := n*PI/2.0;
  394.     y := FixAngle(x);
  395.     WRITELN (n:3,' ',x:8:5,' ',y:8:5)
  396.   END;
  397.   WRITELN;
  398.   WRITELN;
  399.  
  400.   WRITELN ('Real power function:  Pwr = x^y');
  401.   WRITELN;
  402.   WRITELN ('        x        y         x^y');
  403.   WRITELN ('    -------- -------- ------------');
  404.   WRITELN (' ':4,2.1:8:5,' ',-2.5:8:5,Pwr(2.1,-2.5):12:9);
  405.   WRITELN (' ':4,2.1:8:5,' ', 2.5:8:5,Pwr(2.1, 2.5):12:9);
  406.   WRITELN (' ':4,1.4:8:5,' ', 8.9:8:5,Pwr(1.2, 8.9):12:9);
  407.   WRITELN (' ':4,0.0:8:5,' ', 2.0:8:5,Pwr(0.0, 2.0):12:9);
  408.   WRITELN (' ':4,4.2:8:5,' ', 0.0:8:5,Pwr(4.2, 0.0):12:9);
  409.   WRITELN;
  410.  
  411. END {cdemo}.
  412.